home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXCLOCK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  28.4 KB  |  948 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RXClock;
  13.  
  14. interface
  15.  
  16. {$I RX.INC}
  17.  
  18.  
  19. uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
  20.     Forms, StdCtrls, ExtCtrls, Menus, RxTimer, RTLConsts;
  21.  
  22. type
  23.   TShowClock = (scDigital, scAnalog);
  24.   TPaintMode = (pmPaintAll, pmHandPaint);
  25.  
  26.   TRxClockTime = packed record
  27.     Hour, Minute, Second: Word;
  28.   end;
  29.  
  30.   TRxGetTimeEvent = procedure (Sender: TObject; var ATime: TDateTime) of object;
  31.  
  32. { TRxClock }
  33.  
  34.   TRxClock = class(TCustomPanel)
  35.   private
  36.     { Private declarations }
  37.     FTimer: TRxTimer;
  38.     FAutoSize: Boolean;
  39.     FShowMode: TShowClock;
  40.     FTwelveHour: Boolean;
  41.     FLeadingZero: Boolean;
  42.     FShowSeconds: Boolean;
  43.     FAlarm: TDateTime;
  44.     FAlarmEnabled: Boolean;
  45.     FHooked: Boolean;
  46.     FDotsColor: TColor;
  47.     FAlarmWait: Boolean;
  48.     FDisplayTime: TRxClockTime;
  49.     FClockRect: TRect;
  50.     FClockRadius: Longint;
  51.     FClockCenter: TPoint;
  52.     FOnGetTime: TRxGetTimeEvent;
  53.     FOnAlarm: TNotifyEvent;
  54.     procedure TimerExpired(Sender: TObject);
  55.     procedure GetTime(var T: TRxClockTime);
  56.     function IsAlarmTime(ATime: TDateTime): Boolean;
  57.     procedure SetShowMode(Value: TShowClock);
  58.     function GetAlarmElement(Index: Integer): Byte;
  59.     procedure SetAlarmElement(Index: Integer; Value: Byte);
  60.     procedure SetDotsColor(Value: TColor);
  61.     procedure SetTwelveHour(Value: Boolean);
  62.     procedure SetLeadingZero(Value: Boolean);
  63.     procedure SetShowSeconds(Value: Boolean);
  64.     procedure PaintAnalogClock(PaintMode: TPaintMode);
  65.     procedure Paint3DFrame(var Rect: TRect);
  66.     procedure DrawAnalogFace;
  67.     procedure CircleClock(MaxWidth, MaxHeight: Integer);
  68.     procedure DrawSecondHand(Pos: Integer);
  69.     procedure DrawFatHand(Pos: Integer; HourHand: Boolean);
  70.     procedure PaintTimeStr(var Rect: TRect; FullTime: Boolean);
  71.     procedure ResizeFont(const Rect: TRect);
  72.     procedure ResetAlarm;
  73.     procedure CheckAlarm;
  74.     function FormatSettingsChange(var Message: TMessage): Boolean;
  75.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  76.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  77.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  78.     procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE;
  79.   protected
  80.     { Protected declarations }
  81.     procedure SetAutoSize(Value: Boolean); override;
  82.     procedure Alarm; dynamic;
  83.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  84.     procedure CreateWnd; override;
  85.     procedure DestroyWindowHandle; override;
  86.     procedure Loaded; override;
  87.     procedure Paint; override;
  88.     function GetSystemTime: TDateTime; virtual;
  89.   public
  90.     { Public declarations }
  91.     constructor Create(AOwner: TComponent); override;
  92.     destructor Destroy; override;
  93.     procedure SetAlarmTime(AlarmTime: TDateTime);
  94.     procedure UpdateClock;
  95.   published
  96.     { Published declarations }
  97.     property AlarmEnabled: Boolean read FAlarmEnabled write FAlarmEnabled default False;
  98.     property AlarmHour: Byte Index 1 read GetAlarmElement write SetAlarmElement default 0;
  99.     property AlarmMinute: Byte Index 2 read GetAlarmElement write SetAlarmElement default 0;
  100.     property AlarmSecond: Byte Index 3 read GetAlarmElement write SetAlarmElement default 0;
  101.     property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
  102.     property BevelInner default bvLowered;
  103.     property BevelOuter default bvRaised;
  104.     property DotsColor: TColor read FDotsColor write SetDotsColor default clTeal;
  105.     property ShowMode: TShowClock read FShowMode write SetShowMode default scDigital;
  106.     property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default True;
  107.     property TwelveHour: Boolean read FTwelveHour write SetTwelveHour default False;
  108.     property LeadingZero: Boolean read FLeadingZero write SetLeadingZero default True;
  109.     property Align;
  110.     property BevelWidth;
  111.     property BorderWidth;
  112.     property BorderStyle;
  113. {$IFDEF RX_D4}
  114.     property Anchors;
  115.     property Constraints;
  116.     property UseDockManager default True;
  117.     property DockSite;
  118.     property DragKind;
  119.     property FullRepaint;
  120. {$ENDIF}
  121.     property Color;
  122.     property Ctl3D;
  123.     property Cursor;
  124.     property DragMode;
  125.     property DragCursor;
  126.     property Enabled;
  127.     property Font;
  128.     property ParentColor;
  129.     property ParentCtl3D;
  130.     property ParentFont;
  131.     property ParentShowHint;
  132.     property PopupMenu;
  133.     property ShowHint;
  134.     property Visible;
  135.     property OnAlarm: TNotifyEvent read FOnAlarm write FOnAlarm;
  136.     property OnGetTime: TRxGetTimeEvent read FOnGetTime write FOnGetTime;
  137.     property OnClick;
  138.     property OnDblClick;
  139.     property OnMouseMove;
  140.     property OnMouseDown;
  141.     property OnMouseUp;
  142.     property OnDragOver;
  143.     property OnDragDrop;
  144.     property OnEndDrag;
  145.     property OnResize;
  146. {$IFDEF RX_D5}
  147.     property OnContextPopup;
  148. {$ENDIF}
  149. {$IFDEF WIN32}
  150.     property OnStartDrag;
  151. {$ENDIF}
  152. {$IFDEF RX_D4}
  153.     property OnCanResize;
  154.     property OnConstrainedResize;
  155.     property OnDockDrop;
  156.     property OnDockOver;
  157.     property OnEndDock;
  158.     property OnGetSiteInfo;
  159.     property OnStartDock;
  160.     property OnUnDock;
  161. {$ENDIF}
  162.   end;
  163.  
  164. implementation
  165.  
  166. uses Consts, VCLUtils;
  167.  
  168. const
  169.   Registered: Boolean = False;
  170.  
  171. type
  172.   PPointArray = ^TPointArray;
  173.   TPointArray = array [0..60 * 2 - 1] of TSmallPoint;
  174.  
  175. const
  176.   ClockData: array[0..60 * 4 - 1] of Byte = (
  177.     $00, $00, $C1, $E0, $44, $03, $EC, $E0, $7F, $06, $6F, $E1,
  178.     $A8, $09, $48, $E2, $B5, $0C, $74, $E3, $9F, $0F, $F0, $E4,
  179.     $5E, $12, $B8, $E6, $E9, $14, $C7, $E8, $39, $17, $17, $EB,
  180.     $48, $19, $A2, $ED, $10, $1B, $60, $F0, $8C, $1C, $4B, $F3,
  181.     $B8, $1D, $58, $F6, $91, $1E, $81, $F9, $14, $1F, $BC, $FC,
  182.     $40, $1F, $00, $00, $14, $1F, $44, $03, $91, $1E, $7F, $06,
  183.     $B8, $1D, $A8, $09, $8C, $1C, $B5, $0C, $10, $1B, $A0, $0F,
  184.     $48, $19, $5E, $12, $39, $17, $E9, $14, $E9, $14, $39, $17,
  185.     $5E, $12, $48, $19, $9F, $0F, $10, $1B, $B5, $0C, $8C, $1C,
  186.     $A8, $09, $B8, $1D, $7F, $06, $91, $1E, $44, $03, $14, $1F,
  187.     $00, $00, $3F, $1F, $BC, $FC, $14, $1F, $81, $F9, $91, $1E,
  188.     $58, $F6, $B8, $1D, $4B, $F3, $8C, $1C, $60, $F0, $10, $1B,
  189.     $A2, $ED, $48, $19, $17, $EB, $39, $17, $C7, $E8, $E9, $14,
  190.     $B8, $E6, $5E, $12, $F0, $E4, $9F, $0F, $74, $E3, $B5, $0C,
  191.     $48, $E2, $A8, $09, $6F, $E1, $7F, $06, $EC, $E0, $44, $03,
  192.     $C1, $E0, $00, $00, $EC, $E0, $BC, $FC, $6F, $E1, $81, $F9,
  193.     $48, $E2, $58, $F6, $74, $E3, $4B, $F3, $F0, $E4, $60, $F0,
  194.     $B8, $E6, $A2, $ED, $C7, $E8, $17, $EB, $17, $EB, $C7, $E8,
  195.     $A2, $ED, $B8, $E6, $61, $F0, $F0, $E4, $4B, $F3, $74, $E3,
  196.     $58, $F6, $48, $E2, $81, $F9, $6F, $E1, $BC, $FC, $EC, $E0);
  197.  
  198. const
  199.   AlarmSecDelay = 60; { seconds for try alarm event after alarm time occured }
  200.   MaxDotWidth   = 25; { maximum Hour-marking dot width  }
  201.   MinDotWidth   = 2;  { minimum Hour-marking dot width  }
  202.   MinDotHeight  = 1;  { minimum Hour-marking dot height }
  203.  
  204.   { distance from the center of the clock to... }
  205.   HourSide   = 7;   { ...either side of the Hour hand   }
  206.   MinuteSide = 5;   { ...either side of the Minute hand }
  207.   HourTip    = 60;  { ...the tip of the Hour hand       }
  208.   MinuteTip  = 80;  { ...the tip of the Minute hand     }
  209.   SecondTip  = 80;  { ...the tip of the Second hand     }
  210.   HourTail   = 15;  { ...the tail of the Hour hand      }
  211.   MinuteTail = 20;  { ...the tail of the Minute hand    }
  212.  
  213.   { conversion factors }
  214.   CirTabScale = 8000; { circle table values scale down value  }
  215.   MmPerDm     = 100;  { millimeters per decimeter             }
  216.  
  217.   { number of hand positions on... }
  218.   HandPositions = 60;                    { ...entire clock         }
  219.   SideShift     = (HandPositions div 4); { ...90 degrees of clock  }
  220.   TailShift     = (HandPositions div 2); { ...180 degrees of clock }
  221.  
  222. var
  223.   CircleTab: PPointArray;
  224.   HRes: Integer;    { width of the display (in pixels)                    }
  225.   VRes: Integer;    { height of the display (in raster lines)             }
  226.   AspectH: Longint; { number of pixels per decimeter on the display       }
  227.   AspectV: Longint; { number of raster lines per decimeter on the display }
  228.  
  229. { Exception routine }
  230.  
  231. procedure InvalidTime(Hour, Min, Sec: Word);
  232. var
  233.   sTime: string[50];
  234. begin
  235.   sTime := IntToStr(Hour) + TimeSeparator + IntToStr(Min) +
  236.     TimeSeparator + IntToStr(Sec);
  237.   raise EConvertError.CreateFmt(ResStr(SInvalidTime), [sTime]);
  238. end;
  239.  
  240. function VertEquiv(l: Integer): Integer;
  241. begin
  242.   VertEquiv := Longint(l) * AspectV div AspectH;
  243. end;
  244.  
  245. function HorzEquiv(l: Integer): Integer;
  246. begin
  247.   HorzEquiv := Longint(l) * AspectH div AspectV;
  248. end;
  249.  
  250. function LightColor(Color: TColor): TColor;
  251. var
  252.   L: Longint;
  253.   C: array[1..3] of Byte;
  254.   I: Byte;
  255. begin
  256.   L := ColorToRGB(Color);
  257.   C[1] := GetRValue(L); C[2] := GetGValue(L); C[3] := GetBValue(L);
  258.   for I := 1 to 3 do begin
  259.     if C[I] = $FF then begin
  260.       Result := clBtnHighlight;
  261.       Exit;
  262.     end;
  263.     if C[I] <> 0 then
  264.       if C[I] = $C0 then C[I] := $FF
  265.       else C[I] := C[I] + $7F;
  266.   end;
  267.   Result := TColor(RGB(C[1], C[2], C[3]));
  268. end;
  269.  
  270. procedure ClockInit;
  271. var
  272.   Pos: Integer;   { hand position Index into the circle table }
  273.   vSize: Integer; { height of the display in millimeters      }
  274.   hSize: Integer; { width of the display in millimeters       }
  275.   DC: HDC;
  276. begin
  277.   DC := GetDC(0);
  278.   try
  279.     VRes := GetDeviceCaps(DC, VERTRES);
  280.     HRes := GetDeviceCaps(DC, HORZRES);
  281.     vSize := GetDeviceCaps(DC, VERTSIZE);
  282.     hSize := GetDeviceCaps(DC, HORZSIZE);
  283.   finally
  284.     ReleaseDC(0, DC);
  285.   end;
  286.   AspectV := (Longint(VRes) * MmPerDm) div Longint(vSize);
  287.   AspectH := (Longint(HRes) * MmPerDm) div Longint(hSize);
  288.   CircleTab := PPointArray(@ClockData);
  289.   for Pos := 0 to HandPositions - 1 do
  290.     CircleTab^[Pos].Y := VertEquiv(CircleTab^[Pos].Y);
  291. end;
  292.  
  293. function HourHandPos(T: TRxClockTime): Integer;
  294. begin
  295.   Result := (T.Hour * 5) + (T.Minute div 12);
  296. end;
  297.  
  298. { Digital clock font routine }
  299.  
  300. procedure SetNewFontSize(Canvas: TCanvas; const Text: string;
  301.   MaxH, MaxW: Integer);
  302. const
  303.   fHeight = 1000;
  304. var
  305.   Font: TFont;
  306.   NewH: Integer;
  307. begin
  308.   Font := Canvas.Font;
  309.   { empiric calculate character height by cell height }
  310.   MaxH := MulDiv(MaxH, 4, 5);
  311.   with Font do begin
  312.     Height := -fHeight;
  313.     NewH := MulDiv(fHeight, MaxW, Canvas.TextWidth(Text));
  314.     if NewH > MaxH then NewH := MaxH;
  315.     Height := -NewH;
  316.   end;
  317. end;
  318.  
  319. { TRxClock }
  320.  
  321. constructor TRxClock.Create(AOwner: TComponent);
  322. begin
  323.   inherited Create(AOwner);
  324.   if not Registered then begin
  325.     ClockInit;
  326.     Registered := True;
  327.   end;
  328.   Caption := TimeToStr(Time);
  329.   ControlStyle := ControlStyle - [csSetCaption] 
  330.     {$IFDEF WIN32} - [csReplicatable] {$ENDIF};
  331.   BevelInner := bvLowered;
  332.   BevelOuter := bvRaised;
  333.   FTimer := TRxTimer.Create(Self);
  334.   FTimer.Interval := 450; { every second }
  335.   FTimer.OnTimer := TimerExpired;
  336.   FDotsColor := clTeal;
  337.   FShowSeconds := True;
  338.   FLeadingZero := True;
  339.   GetTime(FDisplayTime);
  340.   if FDisplayTime.Hour >= 12 then Dec(FDisplayTime.Hour, 12);
  341.   FAlarmWait := True;
  342.   FAlarm := EncodeTime(0, 0, 0, 0);
  343. end;
  344.  
  345. destructor TRxClock.Destroy;
  346. begin
  347.   if FHooked then begin
  348.     Application.UnhookMainWindow(FormatSettingsChange);
  349.     FHooked := False;
  350.   end;
  351.   inherited Destroy;
  352. end;
  353.  
  354. procedure TRxClock.Loaded;
  355. begin
  356.   inherited Loaded;
  357.   ResetAlarm;
  358. end;
  359.  
  360. procedure TRxClock.CreateWnd;
  361. begin
  362.   inherited CreateWnd;
  363.   if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
  364.   begin
  365.     Application.HookMainWindow(FormatSettingsChange);
  366.     FHooked := True;
  367.   end;
  368. end;
  369.  
  370. procedure TRxClock.DestroyWindowHandle;
  371. begin
  372.   if FHooked then begin
  373.     Application.UnhookMainWindow(FormatSettingsChange);
  374.     FHooked := False;
  375.   end;
  376.   inherited DestroyWindowHandle;
  377. end;
  378.  
  379. procedure TRxClock.CMCtl3DChanged(var Message: TMessage);
  380. begin
  381.   inherited;
  382.   if ShowMode = scAnalog then Invalidate;
  383. end;
  384.  
  385. procedure TRxClock.CMTextChanged(var Message: TMessage);
  386. begin
  387.   { Skip this message, no repaint }
  388. end;
  389.  
  390. procedure TRxClock.CMFontChanged(var Message: TMessage);
  391. begin
  392.   inherited;
  393.   Invalidate;
  394.   if AutoSize then Realign;
  395. end;
  396.  
  397. procedure TRxClock.WMTimeChange(var Message: TMessage);
  398. begin
  399.   inherited;
  400.   Invalidate;
  401.   CheckAlarm;
  402. end;
  403.  
  404. function TRxClock.FormatSettingsChange(var Message: TMessage): Boolean;
  405. begin
  406.   Result := False;
  407.   case Message.Msg of
  408.     WM_WININICHANGE:
  409.       begin
  410.         Invalidate;
  411.         if AutoSize then Realign;
  412.       end;
  413.   end;
  414. end;
  415.  
  416. function TRxClock.GetSystemTime: TDateTime;
  417. begin
  418.   Result := SysUtils.Time;
  419.   if Assigned(FOnGetTime) then FOnGetTime(Self, Result);
  420. end;
  421.  
  422. procedure TRxClock.GetTime(var T: TRxClockTime);
  423. var
  424.   MSec: Word;
  425. begin
  426.   with T do
  427.     DecodeTime(GetSystemTime, Hour, Minute, Second, MSec);
  428. end;
  429.  
  430. procedure TRxClock.UpdateClock;
  431. begin
  432.   Invalidate;
  433.   if AutoSize then Realign;
  434.   Update;
  435. end;
  436.  
  437. procedure TRxClock.ResetAlarm;
  438. begin
  439.   FAlarmWait := (FAlarm > GetSystemTime) or (FAlarm = 0);
  440. end;
  441.  
  442. function TRxClock.IsAlarmTime(ATime: TDateTime): Boolean;
  443. var
  444.   Hour, Min, Sec, MSec: Word;
  445.   AHour, AMin, ASec: Word;
  446. begin
  447.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  448.   DecodeTime(ATime, AHour, AMin, ASec, MSec);
  449.   Result := {FAlarmWait and} (Hour = AHour) and (Min = AMin) and
  450.     (ASec >= Sec) and (ASec <= Sec + AlarmSecDelay);
  451. end;
  452.  
  453. procedure TRxClock.ResizeFont(const Rect: TRect);
  454. var
  455.   H, W: Integer;
  456.   DC: HDC;
  457.   TimeStr: string;
  458. begin
  459.   H := Rect.Bottom - Rect.Top - 4;
  460.   W := (Rect.Right - Rect.Left - 30);
  461.   if (H <= 0) or (W <= 0) then Exit;
  462.   DC := GetDC(0);
  463.   try
  464.     Canvas.Handle := DC;
  465.     Canvas.Font := Font;
  466.     TimeStr := '88888';
  467.     if FShowSeconds then TimeStr := TimeStr + '888';
  468.     if FTwelveHour then begin
  469.       if Canvas.TextWidth(TimeAMString) > Canvas.TextWidth(TimePMString) then
  470.         TimeStr := TimeStr + ' ' + TimeAMString
  471.       else TimeStr := TimeStr + ' ' + TimePMString;
  472.     end;
  473.     SetNewFontSize(Canvas, TimeStr, H, W);
  474.     Font := Canvas.Font;
  475.   finally
  476.     Canvas.Handle := 0;
  477.     ReleaseDC(0, DC);
  478.   end;
  479. end;
  480.  
  481. procedure TRxClock.AlignControls(AControl: TControl; var Rect: TRect);
  482. {$IFDEF RX_D4}
  483. var
  484.   InflateWidth: Integer;
  485. {$ENDIF}
  486. begin
  487.   inherited AlignControls(AControl, Rect);
  488.   FClockRect := Rect;
  489. {$IFDEF RX_D4}
  490.   InflateWidth := BorderWidth + 1;
  491.   if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
  492.   if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
  493.   InflateRect(FClockRect, -InflateWidth, -InflateWidth);
  494. {$ENDIF}
  495.   with FClockRect do CircleClock(Right - Left, Bottom - Top);
  496.   if AutoSize then ResizeFont(Rect);
  497. end;
  498.  
  499. procedure TRxClock.Alarm;
  500. begin
  501.   if Assigned(FOnAlarm) then FOnAlarm(Self);
  502. end;
  503.  
  504. procedure TRxClock.SetAutoSize(Value: Boolean);
  505. begin
  506.   inherited SetAutoSize(Value);
  507.   FAutoSize := Value;
  508.   if FAutoSize then begin
  509.     Invalidate;
  510.     Realign;
  511.   end;
  512. end;
  513.  
  514. procedure TRxClock.SetTwelveHour(Value: Boolean);
  515. begin
  516.   if FTwelveHour <> Value then begin
  517.     FTwelveHour := Value;
  518.     Invalidate;
  519.     if AutoSize then Realign;
  520.   end;
  521. end;
  522.  
  523. procedure TRxClock.SetLeadingZero(Value: Boolean);
  524. begin
  525.   if FLeadingZero <> Value then begin
  526.     FLeadingZero := Value;
  527.     Invalidate;
  528.   end;
  529. end;
  530.  
  531. procedure TRxClock.SetShowSeconds(Value: Boolean);
  532. begin
  533.   if FShowSeconds <> Value then begin
  534.     {if FShowSeconds and (ShowMode = scAnalog) then
  535.       DrawSecondHand(FDisplayTime.Second);}
  536.     FShowSeconds := Value;
  537.     Invalidate;
  538.     if AutoSize then Realign;
  539.   end;
  540. end;
  541.  
  542. procedure TRxClock.SetDotsColor(Value: TColor);
  543. begin
  544.   if Value <> FDotsColor then begin
  545.     FDotsColor := Value;
  546.     Invalidate;
  547.   end;
  548. end;
  549.  
  550. procedure TRxClock.SetShowMode(Value: TShowClock);
  551. begin
  552.   if FShowMode <> Value then begin
  553.     FShowMode := Value;
  554.     Invalidate;
  555.   end;
  556. end;
  557.  
  558. function TRxClock.GetAlarmElement(Index: Integer): Byte;
  559. var
  560.   Hour, Min, Sec, MSec: Word;
  561. begin
  562.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  563.   case Index of
  564.     1: Result := Hour;
  565.     2: Result := Min;
  566.     3: Result := Sec;
  567.     else Result := 0;
  568.   end;
  569. end;
  570.  
  571. procedure TRxClock.SetAlarmElement(Index: Integer; Value: Byte);
  572. var
  573.   Hour, Min, Sec, MSec: Word;
  574. begin
  575.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  576.   case Index of
  577.     1: Hour := Value;
  578.     2: Min := Value;
  579.     3: Sec := Value;
  580.     else Exit;
  581.   end;
  582.   if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
  583.     FAlarm := EncodeTime(Hour, Min, Sec, 0);
  584.     ResetAlarm;
  585.   end
  586.   else InvalidTime(Hour, Min, Sec);
  587. end;
  588.  
  589. procedure TRxClock.SetAlarmTime(AlarmTime: TDateTime);
  590. var
  591.   Hour, Min, Sec, MSec: Word;
  592. begin
  593.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  594.   if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
  595.     FAlarm := Frac(AlarmTime);
  596.     ResetAlarm;
  597.   end
  598.   else InvalidTime(Hour, Min, Sec);
  599. end;
  600.  
  601. procedure TRxClock.TimerExpired(Sender: TObject);
  602. var
  603.   DC: HDC;
  604.   Rect: TRect;
  605.   InflateWidth: Integer;
  606. begin
  607.   DC := GetDC(Handle);
  608.   try
  609.     Canvas.Handle := DC;
  610.     Canvas.Brush.Color := Color;
  611.     Canvas.Font := Font;
  612.     Canvas.Pen.Color := Font.Color;
  613.     if FShowMode = scAnalog then PaintAnalogClock(pmHandPaint)
  614.     else begin
  615.       Rect := GetClientRect;
  616.       InflateWidth := BorderWidth;
  617.       if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
  618.       if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
  619.       InflateRect(Rect, -InflateWidth, -InflateWidth);
  620.       PaintTimeStr(Rect, False);
  621.     end;
  622.   finally
  623.     Canvas.Handle := 0;
  624.     ReleaseDC(Handle, DC);
  625.   end;
  626.   CheckAlarm;
  627. end;
  628.  
  629. procedure TRxClock.CheckAlarm;
  630. begin
  631.   if FAlarmEnabled and IsAlarmTime(GetSystemTime) then begin
  632.     if FAlarmWait then begin
  633.       FAlarmWait := False;
  634.       Alarm;
  635.     end;
  636.   end
  637.   else ResetAlarm;
  638. end;
  639.  
  640. procedure TRxClock.DrawAnalogFace;
  641. var
  642.   Pos, DotHeight, DotWidth: Integer;
  643.   DotCenter: TPoint;
  644.   R: TRect;
  645.   SaveBrush, SavePen: TColor;
  646.   MinDots: Boolean;
  647. begin
  648.   DotWidth := (MaxDotWidth * Longint(FClockRect.Right - FClockRect.Left)) div HRes;
  649.   DotHeight := VertEquiv(DotWidth);
  650.   if DotHeight < MinDotHeight then DotHeight := MinDotHeight;
  651.   if DotWidth < MinDotWidth then DotWidth := MinDotWidth;
  652.   DotCenter.X := DotWidth div 2;
  653.   DotCenter.Y := DotHeight div 2;
  654.   InflateRect(FClockRect, -DotCenter.Y, -DotCenter.X);
  655.   FClockRadius := ((FClockRect.Right - FClockRect.Left) div 2);
  656.   FClockCenter.X := FClockRect.Left + FClockRadius;
  657.   FClockCenter.Y := FClockRect.Top + ((FClockRect.Bottom - FClockRect.Top) div 2);
  658.   InflateRect(FClockRect, DotCenter.Y, DotCenter.X);
  659.   SaveBrush := Canvas.Brush.Color;
  660.   SavePen := Canvas.Pen.Color;
  661.   try
  662.     Canvas.Brush.Color := Canvas.Pen.Color;
  663.     MinDots := ((DotWidth > MinDotWidth) and (DotHeight > MinDotHeight));
  664.     for Pos := 0 to HandPositions - 1 do begin
  665.       R.Top := (CircleTab^[Pos].Y * FClockRadius) div CirTabScale + FClockCenter.Y;
  666.       R.Left := (CircleTab^[Pos].X * FClockRadius) div CirTabScale + FClockCenter.X;
  667.       if (Pos mod 5) <> 0 then begin
  668.         if MinDots then begin
  669.           if Ctl3D then begin
  670.             Canvas.Brush.Color := clBtnShadow;
  671.             OffsetRect(R, -1, -1);
  672.             R.Right := R.Left + 2;
  673.             R.Bottom := R.Top + 2;
  674.             Canvas.FillRect(R);
  675.             Canvas.Brush.Color := clBtnHighlight;
  676.             OffsetRect(R, 1, 1);
  677.             Canvas.FillRect(R);
  678.             Canvas.Brush.Color := Self.Color;
  679.           end;
  680.           R.Right := R.Left + 1;
  681.           R.Bottom := R.Top + 1;
  682.           Canvas.FillRect(R);
  683.         end;
  684.       end
  685.       else begin
  686.         R.Right := R.Left + DotWidth;
  687.         R.Bottom := R.Top + DotHeight;
  688.         OffsetRect(R, -DotCenter.X, -DotCenter.Y);
  689.         if Ctl3D and MinDots then
  690.           with Canvas do begin
  691.             Brush.Color := FDotsColor;
  692.             Brush.Style := bsSolid;
  693.             FillRect(R);
  694.             Frame3D(Canvas, R, LightColor(FDotsColor), clWindowFrame, 1);
  695.           end;
  696.         Canvas.Brush.Color := Canvas.Pen.Color;
  697.         if not (Ctl3D and MinDots) then Canvas.FillRect(R);
  698.       end;
  699.     end;
  700.   finally
  701.     Canvas.Brush.Color := SaveBrush;
  702.     Canvas.Pen.Color := SavePen;
  703.   end;
  704. end;
  705.  
  706. procedure TRxClock.CircleClock(MaxWidth, MaxHeight: Integer);
  707. var
  708.   ClockHeight: Integer;
  709.   ClockWidth: Integer;
  710. begin
  711.   if MaxWidth > HorzEquiv(MaxHeight) then begin
  712.     ClockWidth := HorzEquiv(MaxHeight);
  713.     FClockRect.Left := FClockRect.Left + ((MaxWidth - ClockWidth) div 2);
  714.     FClockRect.Right := FClockRect.Left + ClockWidth;
  715.   end
  716.   else begin
  717.     ClockHeight := VertEquiv(MaxWidth);
  718.     FClockRect.Top := FClockRect.Top + ((MaxHeight - ClockHeight) div 2);
  719.     FClockRect.Bottom := FClockRect.Top + ClockHeight;
  720.   end;
  721. end;
  722.  
  723. procedure TRxClock.DrawSecondHand(Pos: Integer);
  724. var
  725.   Radius: Longint;
  726.   SaveMode: TPenMode;
  727. begin
  728.   Radius := (FClockRadius * SecondTip) div 100;
  729.   SaveMode := Canvas.Pen.Mode;
  730.   Canvas.Pen.Mode := pmNot;
  731.   try
  732.     Canvas.MoveTo(FClockCenter.X, FClockCenter.Y);
  733.     Canvas.LineTo(FClockCenter.X + ((CircleTab^[Pos].X * Radius) div
  734.       CirTabScale), FClockCenter.Y + ((CircleTab^[Pos].Y * Radius) div
  735.       CirTabScale));
  736.   finally
  737.     Canvas.Pen.Mode := SaveMode;
  738.   end;
  739. end;
  740.  
  741. procedure TRxClock.DrawFatHand(Pos: Integer; HourHand: Boolean);
  742. var
  743.   ptSide, ptTail, ptTip: TPoint;
  744.   Index, Hand: Integer;
  745.   Scale: Longint;
  746.   SaveMode: TPenMode;
  747. begin
  748.   if HourHand then Hand := HourSide else Hand := MinuteSide;
  749.   Scale := (FClockRadius * Hand) div 100;
  750.   Index := (Pos + SideShift) mod HandPositions;
  751.   ptSide.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
  752.   ptSide.X := (CircleTab^[Index].X * Scale) div CirTabScale;
  753.   if HourHand then Hand := HourTip else Hand := MinuteTip;
  754.   Scale := (FClockRadius * Hand) div 100;
  755.   ptTip.Y := (CircleTab^[Pos].Y * Scale) div CirTabScale;
  756.   ptTip.X := (CircleTab^[Pos].X * Scale) div CirTabScale;
  757.   if HourHand then Hand := HourTail else Hand := MinuteTail;
  758.   Scale := (FClockRadius * Hand) div 100;
  759.   Index := (Pos + TailShift) mod HandPositions;
  760.   ptTail.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
  761.   ptTail.X := (CircleTab^[Index].X * Scale) div CirTabScale;
  762.   with Canvas do begin
  763.     SaveMode := Pen.Mode;
  764.     Pen.Mode := pmCopy;
  765.     try
  766.       MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
  767.       LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
  768.       MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
  769.       LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
  770.       MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
  771.       LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
  772.       MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
  773.       LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
  774.     finally
  775.       Pen.Mode := SaveMode;
  776.     end;
  777.   end;
  778. end;
  779.  
  780. procedure TRxClock.PaintAnalogClock(PaintMode: TPaintMode);
  781. var
  782.   NewTime: TRxClockTime;
  783. begin
  784.   Canvas.Pen.Color := Font.Color;
  785.   Canvas.Brush.Color := Color;
  786.   SetBkMode(Canvas.Handle, TRANSPARENT);
  787.   if PaintMode = pmPaintAll then begin
  788.     with Canvas do begin
  789.       FillRect(FClockRect);
  790.       Pen.Color := Self.Font.Color;
  791.       DrawAnalogFace;
  792.       DrawFatHand(HourHandPos(FDisplayTime), True);
  793.       DrawFatHand(FDisplayTime.Minute, False);
  794.       Pen.Color := Brush.Color;
  795.       if ShowSeconds then DrawSecondHand(FDisplayTime.Second);
  796.     end;
  797.   end
  798.   else begin
  799.     with Canvas do begin
  800.       Pen.Color := Brush.Color;
  801.       GetTime(NewTime);
  802.       if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
  803.       if (NewTime.Second <> FDisplayTime.Second) then
  804.         if ShowSeconds then DrawSecondHand(FDisplayTime.Second);
  805.       if ((NewTime.Minute <> FDisplayTime.Minute) or
  806.         (NewTime.Hour <> FDisplayTime.Hour)) then
  807.       begin
  808.         DrawFatHand(FDisplayTime.Minute, False);
  809.         DrawFatHand(HourHandPos(FDisplayTime), True);
  810.         Pen.Color := Self.Font.Color;
  811.         DrawFatHand(NewTime.Minute, False);
  812.         DrawFatHand(HourHandPos(NewTime), True);
  813.       end;
  814.       Pen.Color := Brush.Color;
  815.       if (NewTime.Second <> FDisplayTime.Second) then begin
  816.         if ShowSeconds then DrawSecondHand(NewTime.Second);
  817.         FDisplayTime := NewTime;
  818.       end;
  819.     end;
  820.   end;
  821. end;
  822.  
  823. procedure TRxClock.PaintTimeStr(var Rect: TRect; FullTime: Boolean);
  824. var
  825.   FontHeight, FontWidth, FullWidth, I, L, H: Integer;
  826.   TimeStr, SAmPm: string;
  827.   NewTime: TRxClockTime;
  828.  
  829.   function IsPartSym(Idx, Num: Byte): Boolean;
  830.   var
  831.     TwoSymHour: Boolean;
  832.   begin
  833.     TwoSymHour := (H >= 10) or FLeadingZero;
  834.     case Idx of
  835.       1: begin {hours}
  836.            Result := True;
  837.          end;
  838.       2: begin {minutes}
  839.            if TwoSymHour then Result := (Num in [4, 5])
  840.            else Result := (Num in [3, 4]);
  841.          end;
  842.       3: begin {seconds}
  843.            if TwoSymHour then Result := FShowSeconds and (Num in [7, 8])
  844.            else Result := FShowSeconds and (Num in [6, 7]);
  845.          end;
  846.       else Result := False;
  847.     end;
  848.   end;
  849.  
  850.   procedure DrawSym(Sym: Char; Num: Byte);
  851.   begin
  852.     if FullTime or
  853.       ((NewTime.Second <> FDisplayTime.Second) and IsPartSym(3, Num)) or
  854.       ((NewTime.Minute <> FDisplayTime.Minute) and IsPartSym(2, Num)) or
  855.       (NewTime.Hour <> FDisplayTime.Hour) then
  856.     begin
  857.       Canvas.FillRect(Rect);
  858.       DrawText(Canvas.Handle, @Sym, 1, Rect, DT_EXPANDTABS or
  859.         DT_VCENTER or DT_CENTER or DT_NOCLIP or DT_SINGLELINE);
  860.     end;
  861.   end;
  862.  
  863. begin
  864.   GetTime(NewTime);
  865.   H := NewTime.Hour;
  866.   if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
  867.   if FTwelveHour then begin
  868.     if H > 12 then Dec(H, 12) else if H = 0 then H := 12;
  869.   end;
  870.   if (not FullTime) and (NewTime.Hour <> FDisplayTime.Hour) then begin
  871.     Repaint;
  872.     Exit;
  873.   end;
  874.   if FLeadingZero then TimeStr := 'hh:mm' else TimeStr := 'h:mm';
  875.   if FShowSeconds then TimeStr := TimeStr + ':ss';
  876.   if FTwelveHour then TimeStr := TimeStr + ' ampm';
  877.   with NewTime do
  878.     TimeStr := FormatDateTime(TimeStr, GetSystemTime);
  879.   if (H >= 10) or FLeadingZero then L := 5 else L := 4;
  880.   if FShowSeconds then Inc(L, 3);
  881.   SAmPm := Copy(TimeStr, L + 1, MaxInt);
  882.   with Canvas do begin
  883.     Font := Self.Font;
  884.     FontHeight := TextHeight('8');
  885.     FontWidth := TextWidth('8');
  886.     FullWidth := TextWidth(SAmPm) + (L * FontWidth);
  887.     with Rect do begin
  888.       Left := ((Right + Left) - FullWidth) div 2 {shr 1};
  889.       Right := Left + FullWidth;
  890.       Top := ((Bottom + Top) - FontHeight) div 2 {shr 1};
  891.       Bottom := Top + FontHeight;
  892.     end;
  893.     Brush.Color := Color;
  894.     for I := 1 to L do begin
  895.       Rect.Right := Rect.Left + FontWidth;
  896.       DrawSym(TimeStr[I], I);
  897.       Inc(Rect.Left, FontWidth);
  898.     end;
  899.     if FullTime or (NewTime.Hour <> FDisplayTime.Hour) then begin
  900.       Rect.Right := Rect.Left + TextWidth(SAmPm);
  901.       DrawText(Handle, @SAmPm[1], Length(SAmPm), Rect,
  902.         DT_EXPANDTABS or DT_VCENTER or DT_NOCLIP or DT_SINGLELINE);
  903.     end;
  904.   end;
  905.   FDisplayTime := NewTime;
  906. end;
  907.  
  908. procedure TRxClock.Paint3DFrame(var Rect: TRect);
  909. var
  910.   TopColor, BottomColor: TColor;
  911.  
  912.   procedure AdjustColors(Bevel: TPanelBevel);
  913.   begin
  914.     TopColor := clBtnHighlight;
  915.     if Bevel = bvLowered then TopColor := clBtnShadow;
  916.     BottomColor := clBtnShadow;
  917.     if Bevel = bvLowered then BottomColor := clBtnHighlight;
  918.   end;
  919.  
  920. begin
  921.   Rect := GetClientRect;
  922.   with Canvas do begin
  923.     Brush.Color := Color;
  924.     FillRect(Rect);
  925.   end;
  926.   if BevelOuter <> bvNone then begin
  927.     AdjustColors(BevelOuter);
  928.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  929.   end;
  930.   InflateRect(Rect, -BorderWidth, -BorderWidth);
  931.   if BevelInner <> bvNone then begin
  932.     AdjustColors(BevelInner);
  933.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  934.   end;
  935. end;
  936.  
  937. procedure TRxClock.Paint;
  938. var
  939.   R: TRect;
  940. begin
  941.   Paint3DFrame(R);
  942.   case FShowMode of
  943.     scDigital: PaintTimeStr(R, True);
  944.     scAnalog: PaintAnalogClock(pmPaintAll);
  945.   end;
  946. end;
  947.  
  948. end.